;;
;; parser unit tests suite

(in-package :oali.core)

;;                 == HELPERS ==
;; in order to find a root cause of an error you'd trace functions:
;; (trace oali.core:parse)
;; (trace oali.core:parse-funcall)
;;
;;                 for cl-defined functions
;; (ext:without-package-lock ("COMMON-LISP") (trace vector-push-extend))
;;

;;
;; strings are used here in order to avoid introducing package-local symbols
(defun test-failures-of-functions-parser ()
  "tests that parser emits proper error messages when it handles functions"

  ;; error condition check macro
  (macrolet ((chk (parse-expr expected-error-condition error-slots-checker)
	       (let ((error-instance (gensym "error-instance")))
		 `(handler-case
		      (parse nil ,parse-expr)
		    (,expected-error-condition (,error-instance)
		      (unless (funcall ,error-slots-checker ,error-instance)
			(error ,error-instance)))))))

    ;; unknown `baz' function called
    (chk "((func foo ()) (func boo () (progn (foo) (baz) (return 0))))"
	 not-defined
	 (lambda (e) (eq 'baz (entity e))))

    ;; invalid number of arguments - `foo' function call
    (chk "((func foo (a)) (func boo () (progn (foo 0 1) (return 0))))"
	 invalid-arguments-count
	 (lambda (e) (and (= 2 (actual e)) (= 1 (expected e)))))
    
    ;; invalid number of arguments in function declaration
    ;; also list as parse-expr is provided instead of a string
    (chk '((func foo (a b c)) (func foo (a b c d) (progn (return 0))))
	 invalid-arguments-count
	 (lambda (e) (and (= 4 (actual e)) (= 3 (expected e))
			  (eq 'function-declaration (where e)))))

    ;; unknown var `v1' is used
    (chk
     "((func foo (a)) (func boo (arg) (progn (foo v1) (return 0))))"
     not-defined
     (lambda (e) (eq 'v1 (entity e))))

    ;; function already has a body
    (chk
     "((func boo (arg) (return 0)) (func boo (arg) (progn (foo arg) (return 0))))"
     multiple-definition
     (lambda (e) (eq (entity e) 'function-body-declaration)))
    
    ;; end
    nil))

;; test that parser accepts valid declarations
(defun test-valid-function-parser ()
  ;; function forward declaration - see `foo' function:
  (parse nil "((func foo (a)) (func boo () (progn (foo 0) (return 0))))")

  ;; reusing defined variable - argument `arg':
  (parse nil  "((func foo (a)) (func boo (arg) (progn (foo arg) (return 0))))"))



(defun test-parse-experiments ()
  (parse nil '((test dump-type uint)
	       (type unsigned long temperature)
	       (test dump-type temperature)
	       (test undefine-type temperature)
	       (test dump-all-types)
	       (test type-defined uint)
	       (test type-undefined unit-type)
	       (type unsigned long unit-type)
	       (test type-defined unit-type)
	       (test undefine-type unit-type)
	       (test type-undefined unit-type)
	       (type unk-unit-type)
	       (test type-defined unk-unit-type)
	       (test dump-all-types)
	       (test undefine-type unk-unit-type)
	       (test type-undefined unk-unit-type)
	       (constraint (is temperature pointer))
	       (test print "Whoa, this is a diagnostic message")
	       (type key)
	       (test dump-type key))))

;;;; tests entry point
;; runs tests, returns nil if all tests succeeded,
;; error-condition is returned otherwise, if suppress-errors is t
(defun run-tests (&optional suppress-errors)
  "runs tests for package oali.core"

  (handler-case
      (progn
	;; start tests pack
	(macrolet ((run (func) `(let ((result (,func)))
				  (format t "~a - PASSED~%" ',func)
				  result)))
	  
	  (run test-failures-of-functions-parser)
	  (run test-valid-function-parser)
	  (run test-parse-experiments))

	;; end of tests pack, nil indicates that no errors happened
	nil)
    (error (e)
      (format t "~%~%>>> TESTS FAILED: error ~a thrown~%" e)

      ;; rethrow if errors shall not be suppressed
      (unless suppress-errors
	(error e))
      e)))



;;
;; experiments
;;


(defparameter *ut-sample-program-1*
  '(

    (test dump-type-uint)

    ))

(defparameter *ut-sample-program-3*
  '(

    (func foo (a b c)
     (comment
      "does this and that"
      (arg a "comment to the a argument")
      (arg b "??")
      (arg c "comment to the c argument"
	   (ontology (mathematics sinus)))
      (result "comment to the result"))

     ;; implementation
     (return 0))

    ;; more complex declaration
    (func foo (a b c)
     (progn
       (return 0)))

    ))

(defparameter *ut-sample-program-4-bubble-sort*
  '(

    ;;
    ;; external types
    (type element)
    (type container)

    ;;
    ;; exported function
    (func bubble-sort (cont)
     (comment
      (cont \"container\"))

     ;;
     ;; implementation
     (let ((swapped true))
       (while swapped
	 (let (i)
	   (set swapped false)
	   (for ((i 0) (< i (- (length cont) 1)) (inc i))
		(if (< (elem cont i) (elem cont (+ i 1)))
		    (progn
		      (swap (elem cont i) (elem cont (+ i 1)))
		      (set swapped true))))))))

    ))

